Načtení balíčků
library(tibble)
library(dplyr)
library(tidyr)
library(GA)
library(pso)
# --
library(plotly)
library(purrr)Definování funkce, která bude optimalizována.
# 0 < x < 5
# 0 < y < 5
f <- function(params) {
x <- params[1]
y <- params[2]
(x - 3.14)^2 + (y - 2.72)^2 + sin(3 * x + 1.41) + sin(4 * y - 1.73)
}Grafické zobrazení funkce.
mult <- 0.1
f_grid <- expand_grid(
x = seq(mult, 5 - mult, by = mult),
y = seq(mult, 5 - mult, by = mult)) |>
mutate(z = map2_dbl(
.x = x, .y = y,
.f = ~ f(c(.x, .y))
))
plot_ly(f_grid,
x = ~ x,
y = ~ y,
z = ~ z) |>
add_mesh()Z grafu lze vidět, že minimum je v bodě \(\sim (3.2, 3.1)\).
Startovací pozice \(0, 0\).
# Minimizes by default
set.seed(123)
gradients_00 <- optim(
par = c(0, 0),
fn = f,
lower = c(0, 0),
upper = c(5, 5),
method = "L-BFGS-B"
)
gradients_00## $par
## [1] 3.185155 1.738793
##
## $value
## [1] -0.9061231
##
## $counts
## function gradient
## 12 12
##
## $convergence
## [1] 0
##
## $message
## [1] "CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH"
Startovací pozice \(0, 0\) s upraveným krokem.
# Minimizes by default
set.seed(123)
gradients_00_step <- optim(
par = c(0, 0),
fn = f,
lower = c(0, 0),
upper = c(5, 5),
method = "L-BFGS-B",
control = list(
ndeps = c(1e-6, 2)
)
)
gradients_00_step## $par
## [1] 3.186656 2.939276
##
## $value
## [1] -1.515974
##
## $counts
## function gradient
## 31 31
##
## $convergence
## [1] 0
##
## $message
## [1] "CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH"
Startovací pozice \(2.5, 2.5\).
# Minimizes by default
set.seed(123)
gradients_25 <- optim(
par = c(2.5, 2.5),
fn = f,
lower = c(0, 0),
upper = c(5, 5),
method = "L-BFGS-B"
)
gradients_25## $par
## [1] 3.185155 3.129803
##
## $value
## [1] -1.808352
##
## $counts
## function gradient
## 9 9
##
## $convergence
## [1] 0
##
## $message
## [1] "CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH"
# Maximizes by default
gares <- ga("real-valued",
fitness = \(params) f(params) * -1,
optim = T,
lower = c(0, 0),
upper = c(5, 5),
run = 100,
seed = 123
)
summary(gares)## ── Genetic Algorithm ───────────────────
##
## GA settings:
## Type = real-valued
## Population size = 50
## Number of generations = 100
## Elitism = 2
## Crossover probability = 0.8
## Mutation probability = 0.1
## Search domain =
## x1 x2
## lower 0 0
## upper 5 5
##
## GA results:
## Iterations = 100
## Fitness function value = 1.808352
## Solution =
## x1 x2
## [1,] 3.185155 3.129803
plot(gares)# Minimizes by default
set.seed(123)
pso <- psoptim(
par = c(0, 0),
fn = f,
lower = c(0, 0),
upper = c(5, 5)
)
pso## $par
## [1] 3.185155 3.129803
##
## $value
## [1] -1.808352
##
## $counts
## function iteration restarts
## 12000 1000 0
##
## $convergence
## [1] 2
##
## $message
## [1] "Maximal number of iterations reached"
tribble(
~type, ~x, ~y, ~fit,
"Gradient (0, 0)", gradients_00$par[1], gradients_00$par[2], gradients_00$value,
"Gradient (0, 0) s krokem", gradients_00_step$par[1], gradients_00_step$par[2], gradients_00_step$value,
"Gradient (2.5, 2.5)", gradients_25$par[1], gradients_25$par[2], gradients_25$value,
"Evoluční algoritmus", gares@solution[1, 1], gares@solution[1, 2], gares@fitnessValue,
"PSO", pso$par[1], pso$par[2], pso$value
) |>
mutate(across(
.cols = where(is.numeric),
.fns = ~num(.x, digits = 5)
))| type | x | y | fit |
|---|---|---|---|
| Gradient (0, 0) | 3.18516 | 1.73879 | -0.90612 |
| Gradient (0, 0) s krokem | 3.18666 | 2.93928 | -1.51597 |
| Gradient (2.5, 2.5) | 3.18516 | 3.12980 | -1.80835 |
| Evoluční algoritmus | 3.18516 | 3.12980 | 1.80835 |
| PSO | 3.18516 | 3.12980 | -1.80835 |